home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_2 / hprpldev.tar / scroll.s < prev    next >
Text File  |  1991-07-12  |  2KB  |  88 lines
  1. *---------------------------------------------------------
  2.  
  3. *
  4. * Include the header file KEYDEFS.H, which defines words
  5. * like kcUpArrow at physical key numbers.
  6. *
  7. INCLUDE KEYDEFS.H
  8. *
  9. * Include the eight characters needed for binary download
  10. *
  11. ASSEMBLE
  12.     NIBASC    /HPHP48-D/
  13. RPL
  14. *
  15. * Begin the secondary
  16. *
  17. ::
  18.   RECLAIMDISP        ( *Claim the alpha display* )
  19.   ClrDA1IsStat        ( *Temporarily disable clock* )
  20. *                       ( *Try removing ClrDA1IsStat* )
  21.   ZEROZERO        ( #0 #0 )
  22.   150 150 MAKEGROB    ( #0 #0 150x150grob )
  23.   XYGROBDISP        (  )
  24.   TURNMENUOFF        ( *Turn off menu line* )
  25. *
  26. * Draw diagonal lines.  Remember that LINEON requires
  27. * requires #x2>#x1!
  28. *
  29.   ZEROZERO        ( #x1 #y1 )
  30.   149 149        ( #x1 #y1 #x2 #y2 )
  31.   LINEON        ( *Draw line* )
  32.   ZERO 149        ( #x1 #y1 )
  33.   149 ZERO        ( #x1 #y1 #x2 #y2 )
  34.   LINEON        ( *Draw line* )
  35. *
  36. * Place text
  37. *
  38.   HARDBUFF
  39.   75 50 "SCROLLING"    ( HBgrob 75 150 "SCROLLING" )
  40.   150 CENTER$3x5    ( HBgrob )
  41.   75 100 "EXAMPLE"      ( HBgrob 75 100 "EXAMPLE" )
  42.   150 CENTER$3x5    ( HBgrob )
  43.   DROPFALSE        ( FALSE )
  44.   { LAM Exit } BIND    ( *Bind POL exit flag* )
  45.   ' NOP            ( *No display action*  )
  46.   ' ::            ( *Hard key handler*   )
  47.     kpNoShift #=casedrop
  48.       ::
  49.          kcUpArrow    ?CaseKeyDef
  50.               :: TakeOver SCROLLUP ;
  51.          kcLeftArrow  ?CaseKeyDef
  52.               :: TakeOver SCROLLLEFT ;
  53.      kcDownArrow  ?CaseKeyDef
  54.               :: TakeOver SCROLLDOWN ;
  55.          kcRightArrow ?CaseKeyDef
  56.               :: TakeOver SCROLLRIGHT ;
  57.          kcOn          ?CaseKeyDef
  58.               :: TakeOver
  59.                  TRUE ' LAM Exit STO ;
  60.          kcRightShift    #=casedrpfls
  61.          DROP 'DoBadKeyT
  62.       ;
  63.     kpRightShift #=casedrop
  64.       ::
  65.          kcUpArrow    ?CaseKeyDef
  66.               :: TakeOver JUMPTOP ;
  67.          kcLeftArrow  ?CaseKeyDef
  68.               :: TakeOver JUMPLEFT ;
  69.      kcDownArrow  ?CaseKeyDef
  70.               :: TakeOver JUMPBOT ;
  71.          kcRightArrow ?CaseKeyDef
  72.               :: TakeOver JUMPRIGHT ;
  73.          kcRightShift #=casedrpfls
  74.          DROP 'DoBadKeyT
  75.       ;
  76.     2DROP 'DoBadKeyT
  77.   ;
  78.   TrueTrue        ( *Key control flags* )
  79.   NULL{}        ( *No softkeys here*  )
  80.   ONEFALSE        ( *1st row, no suspend* )
  81.   ' LAM Exit        ( *App exit condition* )
  82.   ' ERRJMP        ( *Error handler* )
  83.   ParOuterLoop        ( *Run the ParOuterLoop* )
  84.   TURNMENUON        ( *Restore menu row* )
  85.   RECLAIMDISP        ( *Resize and clear display* )
  86.   ClrDAsOK        ( *Redraw display* )
  87. ;
  88.